perm filename SCRCMU.BLI[SCR,SYS] blob
sn#472878 filedate 1979-09-14 generic text, type T, neo UTF8
module scribe(main,ccl,vreg=1,freg=14,sreg=15,timer=external(six12),stack=own(stack,1000))=
begin
require 'SCRIBE.REQ';
! ---------------------------------------------------------------------
%
Copyright -C- 1978,1979 Brian K. Reid Pittsburgh, Pennsylvania
This module is the `main program' of SCRIBE. It is operating-system
dependent, and will need to be rewritten for each operating system on
which SCRIBE is to run.
%
! ---------------------------------------------------------------------
debug(external DebIni;)
begin
global
RSW=0, ! if 1 (via DDT) we reconfigure
STKLC, ! store stack locn here
Stoken Signon=SignonMessage, ! these are for ReConfigure
Stoken SiteSignon=SiteCode, !
Stoken SiteString=SiteName, !
ErrLog, ! nonzero to log and count errors
WrdCount, ! nonzero to count text words
WrdAccum, ! nonzed to accumulate them
FinalChan, ! channel of final output
FinalOut, ! True if final output file wanted
IdemOut, ! true if source being updated
Stoken FinalTemplate, ! Template for final fn
Stoken FinalName, ! resulting final name
Stoken ScrVersion, ! name of our version
Stoken AuxFileName, ! name of .AUX file
Stoken BibFileName, ! name oBibliography figure file
NUserBibFiles, ! count of user-declared bib files
vector UBibNames[10], ! max of 10 user bib files
ErrAnnounce, ! True to type errs on tty
Stoken InFName, ! name of input file
Stoken OUTLFN; ! file name of outline file.
own
Stoken InRoot, ! root output file
Stoken OutRoot, ! root input file
CCLentrycount, ! # files read from ccl
CCLflag, ! true if run via CCL
CCLinputNeeded; !
routine EditVersion(VERS,STR)=
! ---------------------------------------------------------------------
%
This routine edist VERS, a TOPS-10 version code, into string STR.
%
! ---------------------------------------------------------------------
begin
map Pblock STR;
macro
EDIT=0,18$,
MINOR=18,6$,
MAJOR=24,9$,
GROUP=33,3$;
register B,A; ! Note that B=#17, A=#16
Erase(.STR);
APoctv(.STR,.VERS<MAJOR>);
if (A←.VERS<MINOR>) neq 0 then
begin
machop IDIVI=#231;
A←.A-1; ! So 26 is "Z", not "A@"
IDIVI(A,26); ! First char to A, 2nd to B
if .A neq 0 then Append(.STR,.A+"@");
Append(.STR,.B+"A");
end;
if (A←.VERS<EDIT>) neq 0 then
begin
Append(.STR,"(");
APoctv(.STR,.A);
Append(.STR,")");
end;
if (A←.VERS<GROUP>) neq 0 then
begin
Append(.STR,"-");
Append(.STR,.A+"0");
end;
end;
routine GetCCLCommand(STR)=
! ---------------------------------------------------------------------
%
Routine to read in CCL-linkage command string, if any. In CCL mode
(starting-address offset 1), we look for a command in TMPCOR file
`SCR'; if that fails, we look for DSK:###SCR.TMP in the user's
directory. In any case, all text from the file is put into the
string STR, and the file is deleted. We return True if any read was
successful, and False otherwise.
by Craig Everhart, June 1978
%
! ---------------------------------------------------------------------
begin
map Pblock STR;
bind
TFsize=32; ! ** Assumed maximum TMPCOR file size
local
TmpCallBlock[2], ! to do TMPCOR UUO with
TmpBuffer[TFsize], ! Buffer in which to put text from TMPCOR file
Channel, Char;
register R;
machop CALLI=#047;
macro
TmpCor(XX)=Calli(XX,#44)$,
PJob=Calli(VReg,#30)$;
Erase(.STR); ! Make sure it's clear;
TmpCallBlock[0]←sixbit 'SCR'; ! Install our name
TmpCallBlock[1]←((-TFsize)↑18)+TmpBuffer[-1]<0,0>; ! and point to destination
R← (2↑18) + TmpCallBlock[0]<0,0>; ! Point to funny call block
ifskip TmpCor(R)
then
begin ! TMPCOR worked! Now build string.
TmpCallBlock[0]←.R*5; ! Re-use temp space. Count of characters
TmpCallBlock[1]←TmpBuffer[0]<36,7>; ! and byte pointer.
while (TmpCallBlock[0]←.TmpCallBlock[0]-1) geq 0 do
if (Char←GetByte(TmpCallBlock[1])) neq 0
then Append(.STR,.Char);
return True
end
else ! TMPCOR failed; try "DSK:###SCR.TMP[,]".
begin ! Temporarily use STR to build a file name;
APDECF(.STR,PJob,-3); ! `###' part
APSTR(.STR,strcon('SCR.TMP'));
if not OSIckread(.STR) then ! can we read it?
begin
Erase(.STR); ! nope.
return False
end;
Channel←OSIrdopen(.STR); ! Yes. Now get it for real.
Erase(.STR); ! Now use STR for contents, not name.
Char←OSIrdchar(.Channel);
while .Char neq 0 do
begin
Append(.STR,.Char);
Char←OSIrdchar(.Channel)
end;
OSIcldelete(.Channel); ! Delete the file!
return True
end
end;
global routine MakeFileName(Root,Pattern,CreatedName,Input)=
! ---------------------------------------------------------------------
%
This routine generates a full file name from a partially-specified
string. It is used to form, for example, INPUT.AUX from INPUT.
If the flag Input is true, then this file is being used for input
and all directory information will be preserved. If the flag is
false, then the file is being used for output and the directory
information will be discarded.
%
! ---------------------------------------------------------------------
begin
local Breaker;
string(Basis); string(Remainder);
string(Directory); string(Protection);
map Stoken Root:Pattern:CreatedName;
Breaker←GetBreak();
SetBreak(.Breaker,strcon('.<['),null,"R");
if .Root neq 0 then
StrAsg(Remainder,.Root)
else
StrAsg(Remainder,.OutRoot);
Capitalize(Remainder);
Scan(Remainder,Basis,.Breaker);
if BrkChr() eql "." then ! discard extension
begin
ChgBreak(.Breaker,".",False,False);
Scan(Remainder,0,.Breaker);
end;
while StrLen(Remainder) gtr 0 do
begin ! get the rest
if BrkChr() eql "<" then
begin
ChgBreak(.Breaker,"<",False,False);
Scan(Remainder,Protection,.Breaker)
end else if BrkChr() eql "[" then
begin
ChgBreak(.Breaker,"[",False,False);
Scan(Remainder,Directory,.Breaker)
end else Scan(Remainder,0,.Breaker)
end;
Concat(Basis,.Pattern);
Concat(Basis,Protection);
if .Input then Concat(Basis,Directory);
StrAsg(.CreatedName,Basis);
StrDeall(Remainder); StrDeall(Basis);
RelBreak(.Breaker);
.CreatedName
end;
global routine FinalFile(STR)=
! ---------------------------------------------------------------------
%
This routine provides a file name for the final file to the device
driver. By the time FINALFILE is called, we will know for certain
what the output device is, and we can provide the proper output file
name and extension.
%
! ---------------------------------------------------------------------
begin
local Char;
FinalName←StrAlloc();
if StrLen(.FinalTemplate) eql 0 then
Fatal(63,(errval(1,.Device);errval(2,1)));
Erase(.STR);
while StrLen(.FinalTemplate) neq 0 do
begin
Char←lop(.FinalTemplate);
if .Char neq "#" then Append(.Str,.Char);
end;
MakeFileName(.OutRoot,.Str,.FinalName,False);
StrAsg(.Str,.FinalName);
end;
global routine GetAuxName(STR)=
! ---------------------------------------------------------------------
%
This routine returns to the caller a string containing the name that
the .AUX file would have if it existed. The extension .AUX is always
forced, even if the user has provided a name with a different
extension.
STR is the address of a string token into which the name of the AUX
file is copied.
If no .AUX file is found, then the null string is returned.
%
! ---------------------------------------------------------------------
begin
map Pblock STR;
MakeFileName(.AuxFileName,strcon('.AUX'),.Str,True);
if OSIckread(.Str) then return;
MakeFileName(.AuxFileName,strcon('.AUX'),.Str,False);
if OSIckread(.Str) then return;
erase(.Str)
end;
global routine ReConfigure=
! ---------------------------------------------------------------------
%
This routine is to be called from DDT to change the value of
configuration variables so you don't have to patch them. It exits
back to the monitor when it's done.
%
! ---------------------------------------------------------------------
begin
external DFSft; ! in OSI module, routine OSIdfs ;
own ! build a bunch of fake string descrs
CharVect SignonString[80+Qchswrd],
CharVect DefFileTempl[30+Qchswrd],
CharVect SiteStrBuf[100+Qchswrd],
CharVect SiteCodeBuf[24+Qchswrd];
macro PRT(X)=OSItypestring(Strcon(X))$;
routine GetNewValue(Token,OwnBuffer,MaxChars)=
begin
string(Foo);
map Pblock OwnBuffer;
bind CharVect Obuf=OwnBuffer[1];
map Pblock Token;
OsiInString(Foo);
if StrLen(Foo) gtr 0 then
begin
incr Q from 0 to .MaxChars-1 do Obuf[.Q]←0;
incr Q from 0 to mini(StrLen(Foo),.MaxChars)-1 do
Obuf[.Q]←lop(Foo);
OwnBuffer[0]←IptrToChars(Obuf);
end;
Token[0]←.OwnBuffer<0,18>;
end;
PRT('?M?J*** Reconfigure SCRIBE. Type strings, follow with CRLF ***?M?J');
prt('?M?J1. Site Name. Current string: ?M?J ');
OsiTypeString(.SiteString);
prt('?M?J New site name:?M?J ');
GetNewValue(SiteString,SiteStrBuf,100);
prt('?M?J2. Site Code. Current code ');
OsiTypeString(.SiteSignon);
prt('?M?J New site code: ');
GetNewValue(SiteSignon,SiteCodeBuf,24);
PRT('?M?J3. Library definition. Type a template for finding files in the database.?M?J');
PRT(' Use # for filename position, @ for extension position.?M?J');
PRT(' Current template is ');
OSItypestring(.DFSft);
PRT('?M?J');
PRT(' New template: ');
GetNewValue(DfsFt,DefFileTempl,30);
PRT('?M?J4. Signon. Current signon message is ');
OSItypestring(.Signon);PRT('?M?J');
PRT(' New signon message: ');
GetNewValue(Signon,SignonString,80);
PRT('?M?JAll done. Be sure to save the core image.?M?J');
RSW←0;
OSIabort()
end;
routine ScanOptions(OptionString)=
! ---------------------------------------------------------------------
%
This routine scans the string OptionString and processes the Options
that it finds therein.
%
! ---------------------------------------------------------------------
begin
map Pblock OptionString;
label OPT,NXO;
local OptionBreak;
string(ThisOption); string(OptionValue);
macro Optn(A,N)=data(msg(A)),data(N)$;
dataarea(ProgramOptions)
data(0),
Optn('FILE',1), Optn('F',1),
Optn('LA36',2), Optn('A',2),
Optn('LPT',3), Optn('L',3),
Optn('DIABLO',4), Optn('D',4),
Optn('GSI',5), Optn('G',5),
Optn('XGP',6), Optn('X',6),
Optn('VOCABULARY',15),Optn('V',15),Optn('VOCAB',15),Optn('VOC',15),
Optn('WORDS',16), Optn('W',16),
Optn('QUIET',17), Optn('Q',17),
Optn('TERSE',18), Optn('T',18),
Optn('DRAFT',19),
Optn('DEBUG',20),
Optn('DEVICE',21), Optn('DEV',21),
Optn('NOINDEX',22),
locndex(NumOptions,0)
dataend;
FinalOut←True;
ErrAnnounce←9; ! default full verbosity
OptionBreak←GetBreak();
SetBreak(.OptionBreak,strcon('(/,:'),strcon(' ?I)'),"S");
WrdCount←False; WrdAccum←False;
OPT: while StrLen(.OptionString) neq 0 do
NXO: begin
local Which;
Scan(.OptionString,ThisOption,.OptionBreak);
if BrkChr() eql ":" then
Scan(.OptionString,OptionValue,.OptionBreak);
if ParmVal(ThisOption,ProgramOptions,NumOptions/2,
Which,True) then
select .Which of nset
1:SetDevice(strcon('FILE'),True);
2:SetDevice(StrCon('LA36'),True);
3:SetDevice(strcon('LPT'),True);
4:SetDevice(strcon('DIABLO'),True);
5:SetDevice(strcon('GSI'),True);
6:SetDevice(strcon('XGP'),True);
15:(WrdAccum←True; WrdCount←True);
16:WrdCount←True;
17:ErrAnnounce←0;
18:ErrAnnounce←1;
19:(if StrLen(OptionValue) eql 0 then
StrAsg(OptionValue,StrCon('1'));
Quote(OptionValue);
StDefine(strcon('DRAFT'),OptionValue));
20:StylVec[YVdebug]←IntScan(OptionValue,8);
21:SetDevice(OptionValue,True);
22:IxSuppress←True
tesn else begin
MsgOpen(msg('The option code $S is not recognized.?M?J.'));
MsgParm(ThisOption);
MsgTclose();
end
end;
ErrLog←1;
end;
%
The sequencing of these initialization calls is vaguely critical.
OsiIni must be first (to set up the dynamic storage-allocation
routines) and StrIni must be second (to set up string support
package). Don't go randomly changing them around, and think about it
before putting a new one in.
%
label FINISH;
own CCLcommand;
CCLflag←.VREG;
STKLC←Qadr(STACK);
CCLinputNeeded←.CCLflag;
CCLcommand←0;
CCLentrycount←0;
FINISH:while true do
begin
OsiIni();
StrIni();
MsgIni();
SmbIni();
InpIni();
EnvIni();
DrvIni();
CmdIni();
StyIni(); ! must come before FntIni and ScnIni
ScnIni();
FntIni();
BoxIni();
DevIni();
IniIni();
OutIni();
GenIni();
XrfIni();
SepIni();
NotIni(); ! must come after SEPINI
IndIni();
BibIni();
HypIni();
OtlIni();
DEBUG(DebIni();) ! All this does is force DEBUG to be loaded.
if .RSW neq 0 then ReConfigure();
begin
string(InputFileName); ! input file name
string(OutputFileName); ! output file name
string(TempFileName);
string(InputRoot); ! root used for name generation
string(OutputRoot); ! for output generated names
string(AUXF); ! name of aux file
string(LOGF); ! name of log file
string(DICF); ! name of dictionary file
string(FINALF); ! name of final file
string(LINE); ! one line of input
string(OptionString); ! string of OptionString
own OutChan, ! Channel for source update output
BRK, ! Break table for command line scan
OutSpec; ! True if output file spec given
label DID,NXT,CCLtry;
local Pblock XrefTable;
external ?.JBVER;
EditVersion(.?.JBVER,LINE);
ScrVersion←StrCopy(LINE);
if .CCLflag then
begin
if .CCLinputneeded then
begin
MsgOpen(msg('$S Scribe $S?M?J'));
MsgParm(.SiteSignon);
MsgParm(LINE);
MsgTclose()
end else
OSItypestring(Strcon('?M?J?M?J'))
end else begin
NoDebug(
MsgOpen(msg('$S Scribe $S?M?J$S?M?J'));
MsgParm(.SiteSignon);
MsgParm(LINE);
MsgParm(.Signon);
MsgTclose();
);
Debug(
MsgOpen(msg('$S Scribe $S/SIX12?M?J'));
MsgParm(.SiteSignon);
MsgParm(LINE);
MsgTclose();
)
end;
if .CCLinputNeeded then
begin
CCLcommand←StrAlloc();
GetCCLCommand(.CCLCommand)
end;
CCLinputNeeded←False;
OUTLFN←StrAlloc();
FinalTemplate←StrAlloc();
BRK←getbreak();
DID:while true do
NXT:begin
if .CCLflag neq 0 then
begin ! get filename from CCL
setbreak(.BRK,strcon('?J'),strcon('?M'),"S");
Erase(LINE);
scan(.CCLcommand,LINE,.BRK);
if StrLen(LINE) eql 0 then
begin
if .CCLentrycount gtr 0 then
leave FINISH
else begin
Erase(.CCLcommand);
leave NXT
end
end
end else begin ! get filename from TTY
OSItchr("*");
OSIinstring(LINE);
if strlen(LINE) eql 0 then leave NXT
end;
setbreak(.BRK,strcon('=←'),strcon(' ?I'),"S");
capitalize(LINE);
scan(LINE,OutputFileName,.BRK);
if BRKCHR() eql 0 then
begin
strasg(InputFileName,OutputFileName);
Erase(OutputFileName);
OutSpec←False ! no explicit output spec
end else begin
scan(LINE,InputFileName,.BRK);
OutSpec←True
end;
setbreak(.BRK,strcon('/('),null,"R");
strasg(Line,InputFileName);
scan(Line,InputFileName,.BRK);
strasg(OptionString,Line);
if OSIckread(InputFileName) then
leave DID;
SetBreak(.Brk,strcon('.<['),null,"R");
StrAsg(TempFileName,InputFileName);
scan(TempFileName,LINE,.BRK);
if BRKCHR() neq "." then
begin
StrAsg(Line,InputFileName);
MakeFileName(Line,strcon('.MSS'),InputFileName,True);
if OSIckread(InputFileName) then leave DID
end else begin
Concat(Line,TempFileName);
StrAsg(InputFileName,LINE)
end;
MsgOpen(msg('Input file $S not found.?M?J'));
MsgParm(InputFileName);
MsgTClose();
end;
CCLentrycount←.CCLentrycount+1;
InFName←InputFileName;
ScanOption(OptionString);
%
The options are all scanned. Now make sure that we have all of the
file names squared away. If there's no explicit output file name,
then use the input name as a root.
%
if StrLen(OutputFileName) eql 0 then
MakeFileName(InputFileName,strcon('.MSS'),OutputFileName,False);
InRoot←InputFileName;
OutRoot←OutputFileName;
AuxFileName←MakeFileName(InputFileName,strcon('.AUX'),StrAlloc(),True);
BibFileName←MakeFileName(InputFileName,strcon('.BIB'),StrAlloc(),True);
MakeFileName(OutputFileName,strcon('.ERR'),LogF,False);
if .ErrLog neq 0 then
begin
local SavePhase;
Generate(StrCon('ErrLog'),LogF,False,False);
SavePhase←.Phase; ! to understand Phase hack
Phase←TextPhase; ! pls. see routine SEND
Send(StrCon('ErrLog'),null); ! force channel open
Phase←.SavePhase;
end;
if .WrdAccum then
begin
MakeFileName(OutputFileName,strcon('.LEX'),DicF,False);
Generate(Strcon('LEXICON'),DicF,False,False)
end;
MakeFileName(OutputFileName,strcon('.OTL'),.OutLfn,False);
relbreak(.BRK);
StrDeall(LINE);
if not Main(InputFileName) then
(warn(61);FinalOut←0);
MakeFileName(.AuxFileName,strcon('.AUX'),.AuxFileName,False);
OSItypestring(Strcon('.?M?J'));
Generate(StrCon('AUXFILE'),.AuxFileName,False,False);
StyleClose(StrCon('AUXFILE'));
PartClose(StrCon('AUXFILE'));
XrefTable←XRFclose(StrCon('AUXFILE'));
OtlClose(.XrefTable);
PlistPurge(.XrefTable);
DEVterm(StrCon('AUXFILE'));
OSItypestring(crlf);
TallyClose(.FinalName);
if .FinalOut then
begin
OSIclose(.FINALchan);
MsgOpen(msg('**$S for device $S has $I $S$C.?M?J'));
MsgParm(.FinalName);
MsgParm(.Device);
MsgParm(.PPcount);
if .DevCapas[DCPpaged] then MsgParm(strcon('page'))
else MsgParm(strcon('line'));
if .PPcount eql 1 then
MsgParm(0)
else
MsgParm("s");
MsgTclose()
end;
begin
local Stoken AF;
AF←GPclose(Strcon('AUXFILE'));
if .AF neq 0 then
begin
MsgOpen(msg('**$S written.?M?J'));
MsgParm(.AF);
MsgTclose()
end
end;
begin ! close outline file
local Stoken OfName;
OfName←GpClose(strcon('OUTLINE'));
if .OfName neq 0 then
begin
msgOpen(msg('**$S written.?M?J'));
msgParm(.OfName);
msgTclose()
end;
end;
if (.Errlog gtr 1) or (.SKtotal neq 0) then
begin
GPclose(Strcon('ErrLog'));
MsgOpen(msg('**$S lists $I error$C$S$Cand $I missing special characters$S'));
MsgParm(LOGF);
MsgParm(.ErrLog-1);
MsgParm(if .ErrLog neq 2 then "s" else 0);
if .SKtotal neq 0 then
begin
MsgParm(Strcon(' '));
MsgParm(0);
MsgParm(.SKtotal)
end;
MsgParm(strcon('.?M?J'));
MsgTclose()
end else begin ! if no errs, delete .ERR file
GPdelete(Strcon('ErrLog')); ! i.e. just throw it away
end;
end;
if not .CCLflag then leave FINISH;
end;
debug(if (.StylVec[YVdebug] and #10) neq 0 then Six12(#377777000000))
end end eludom;